home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / vm / vm-window.el < prev    next >
Encoding:
Text File  |  1995-08-08  |  21.6 KB  |  602 lines
  1. ;;; Window management code for VM
  2. ;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program; if not, write to the Free Software
  16. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18. (provide 'vm-window)
  19.  
  20. (defun vm-display (buffer display commands configs)
  21. ;; the clearinghouse VM display function.
  22. ;;
  23. ;; First arg BUFFER non-nil is a buffer to display or undisplay.
  24. ;; nil means there is no request to display or undisplay a
  25. ;; buffer.
  26. ;;
  27. ;; Second arg DISPLAY non-nil means to display the buffer, nil means
  28. ;; to undisplay it.  This function guarantees to display the
  29. ;; buffer if requested.  Undisplay is not guaranteed.
  30. ;;
  31. ;; Third arg COMMANDS is a list of symbols.  this-command must
  32. ;; match one of these symbols for a window configuration to be
  33. ;; applied.
  34. ;;
  35. ;; Fourth arg CONFIGS is a list of window configurations to try.
  36. ;; vm-set-window-configuration will step through the list looking
  37. ;; for an existing configuration, and apply the one it finds.
  38. ;;
  39. ;; Display is done this way:
  40. ;;  1. if the buffer is visible in an invisible frame, make that frame visible
  41. ;;  2. if the buffer is already displayed, quit
  42. ;;  3. if vm-display-buffer-hook in non-nil
  43. ;;        run the hooks
  44. ;;        use the selected window/frame to display the buffer
  45. ;;        quit
  46. ;;  4. apply a window configuration
  47. ;;        if the buffer is displayed now, quit
  48. ;;  5. call vm-display-buffer which will display the buffer.
  49. ;;
  50. ;; Undisplay is done this way:
  51. ;;  1. if the buffer is not displayed, quit
  52. ;;  2. if vm-undisplay-buffer-hook is non-nil
  53. ;;        run the hooks
  54. ;;        quit
  55. ;;  3. apply a window configuration
  56. ;;  4, if a window configuration was applied
  57. ;;        quit
  58. ;;  5. call vm-undisplay-buffer which will make the buffer
  59. ;;     disappear from at least one window/frame.
  60. ;;
  61. ;; If display/undisplay is not requested, only window
  62. ;; configuration is done, and only then if the value of
  63. ;; this-command is found in the COMMANDS list.
  64.   (vm-save-buffer-excursion
  65.    (let ((w (and buffer (vm-get-buffer-window buffer))))
  66.      (and buffer (set-buffer buffer))
  67.      (and w display (vm-raise-frame (vm-window-frame w)))
  68.      (and w display (not (eq (vm-selected-frame) (vm-window-frame w)))
  69.       (vm-select-frame (vm-window-frame w)))
  70.      (cond ((and buffer display)
  71.         (if (and vm-display-buffer-hook
  72.              (null (vm-get-visible-buffer-window buffer)))
  73.         (progn (run-hooks 'vm-display-buffer-hook)
  74.                (switch-to-buffer buffer)
  75.                (vm-record-current-window-configuration nil))
  76.           (if (not (and (memq this-command commands)
  77.                 (apply 'vm-set-window-configuration configs)
  78.                 (vm-get-visible-buffer-window buffer)))
  79.           (vm-display-buffer buffer))))
  80.        ((and buffer (not display))
  81.         (if (and vm-undisplay-buffer-hook
  82.              (vm-get-visible-buffer-window buffer))
  83.         (progn (run-hooks 'vm-undisplay-buffer-hook)
  84.                (vm-record-current-window-configuration nil))
  85.           (if (not (and (memq this-command commands)
  86.                 (apply 'vm-set-window-configuration configs)))
  87.           (vm-undisplay-buffer buffer))))
  88.        ((memq this-command commands)
  89.         (apply 'vm-set-window-configuration configs))))))
  90.  
  91. (defun vm-display-buffer (buffer)
  92.   (let ((pop-up-windows (eq vm-mutable-windows t))
  93.     (pop-up-frames vm-mutable-frames))
  94.     (vm-record-current-window-configuration nil)
  95.     (if (or pop-up-frames
  96.         (and (eq vm-mutable-windows t)
  97.          (symbolp
  98.           (vm-buffer-to-label
  99.            (window-buffer
  100.             (selected-window))))))
  101.     (select-window (display-buffer buffer))
  102.       (switch-to-buffer buffer))))
  103.  
  104. (defun vm-undisplay-buffer (buffer)
  105.   (vm-save-buffer-excursion
  106.     (vm-delete-windows-or-frames-on buffer)
  107.     (let ((w (vm-get-buffer-window buffer)))
  108.       (and w (set-window-buffer w (other-buffer))))))
  109.  
  110. (defun vm-load-window-configurations (file)
  111.   (save-excursion
  112.     (let ((work-buffer nil))
  113.       (unwind-protect
  114.       (progn
  115.         (set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*")))
  116.         (erase-buffer)
  117.         (setq vm-window-configurations
  118.           (condition-case ()
  119.               (progn
  120.             (insert-file-contents file)
  121.             (read (current-buffer)))
  122.             (error nil))))
  123.     (and work-buffer (kill-buffer work-buffer))))))
  124.  
  125. (defun vm-store-window-configurations (file)
  126.   (save-excursion
  127.     (let ((work-buffer nil))
  128.       (unwind-protect
  129.       (progn
  130.         (set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*")))
  131.         (erase-buffer)
  132.         (print vm-window-configurations (current-buffer))
  133.         (write-region (point-min) (point-max) file nil 0))
  134.     (and work-buffer (kill-buffer work-buffer))))))
  135.  
  136. (defun vm-set-window-configuration (&rest tags)
  137.   (catch 'done
  138.     (if (not vm-mutable-windows)
  139.     (throw 'done nil))
  140.     (let ((nonexistent " *vm-nonexistent*")
  141.       (nonexistent-summary " *vm-nonexistent-summary*")
  142.       (selected-frame (vm-selected-frame))
  143.       summary message composition edit config)
  144.       (while (and tags (null config))
  145.     (setq config (assq (car tags) vm-window-configurations)
  146.           tags (cdr tags)))
  147.       (or config (setq config (assq 'default vm-window-configurations)))
  148.       (or config (throw 'done nil))
  149.       (setq config (vm-copy config))
  150.       (setq composition (vm-find-composition-buffer t))
  151.       (cond ((eq major-mode 'vm-summary-mode)
  152.          (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer)))
  153.          (throw 'done nil)
  154.            (setq summary (current-buffer))
  155.            (setq message vm-mail-buffer)))
  156.         ((eq major-mode 'vm-mode)
  157.          (setq message (current-buffer)))
  158.         ((eq major-mode 'vm-virtual-mode)
  159.          (setq message (current-buffer)))
  160.         ((eq major-mode 'mail-mode)
  161.          (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer)))
  162.          (throw 'done nil)
  163.            (setq message vm-mail-buffer)))
  164.         ((eq vm-system-state 'editing)
  165.          (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer)))
  166.          (throw 'done nil)
  167.            (setq edit (current-buffer))
  168.            (setq message vm-mail-buffer)))
  169.         ;; not in a VM related buffer, bail...
  170.         (t (throw 'done nil)))
  171.       (set-buffer message)
  172.       ;; if this configuration is already the current one, don't
  173.       ;; set it up again.
  174.       (if (or (and vm-mutable-frames (eq (car config) vm-window-configuration))
  175.           (and (not vm-mutable-frames)
  176.            (listp vm-window-configuration)
  177.            (eq (car config)
  178.                (cdr (assq selected-frame vm-window-configuration)))))
  179.       (throw 'done nil))
  180.       (vm-check-for-killed-summary)
  181.       (or summary (setq summary (or vm-summary-buffer nonexistent-summary)))
  182.       (or composition (setq composition nonexistent))
  183.       (or edit (setq edit nonexistent))
  184.       (tapestry-replace-tapestry-element (nth 1 config) 'buffer-name
  185.                      (function
  186.                       (lambda (x)
  187.                         (if (symbolp x)
  188.                         (symbol-value x)
  189.                           x ))))
  190.       (set-tapestry (nth 1 config) 1)
  191.       (and (get-buffer nonexistent)
  192.        (vm-delete-windows-or-frames-on nonexistent))
  193.       (if (and (vm-get-buffer-window nonexistent-summary)
  194.            (not (vm-get-buffer-window message)))
  195.       ;; user asked for summary to be displayed but doesn't
  196.       ;; have one, nor is the folder buffer displayed.  Help
  197.       ;; the user not to lose here.
  198.       (vm-replace-buffer-in-windows nonexistent-summary message)
  199.     (and (get-buffer nonexistent-summary)
  200.          (vm-delete-windows-or-frames-on nonexistent-summary)))
  201.       (vm-record-current-window-configuration config)
  202.       config )))
  203.  
  204. (defun vm-record-current-window-configuration (config)
  205.   ;; this function continues to be a no-op.
  206.   ;;
  207.   ;; the idea behind this function is that VM can remember what
  208.   ;; the current window configuration is and not rebuild the
  209.   ;; configuration for the next command if it matches what we
  210.   ;; have recorded.
  211.   ;;
  212.   ;; the problem with this idea is that the user can do things
  213.   ;; like C-x 0 and VM has no way of knowing.  So VM thinks the
  214.   ;; right configuration is displayed when in fact it is not,
  215.   ;; which can cause incorrect displays.
  216.   '(let (cell)
  217.     (if (and (listp vm-window-configuration)
  218.          (setq cell (assq (vm-selected-frame) vm-window-configuration)))
  219.     (setcdr cell (car config))
  220.       (setq vm-window-configuration
  221.         (cons
  222.          (cons (vm-selected-frame) (car config))
  223.          vm-window-configuration)))))
  224.  
  225. (defun vm-save-window-configuration (tag)
  226.   "Name and save the current window configuration.
  227. With this command you associate the current window setup with an
  228. action.  Each time you perform this action VM will duplicate this
  229. window setup.
  230.  
  231. Nearly every VM command can have a window configuration
  232. associated with it.  VM also allows some category configurations,
  233. `startup', `reading-message', `composing-message', `editing-message',
  234. `marking-message' and `searching-message' for the commands that
  235. do these things.  There is also a `default' configuration that VM
  236. will use if no other configuration is applicable.  Command
  237. specific configurations are searched for first, then the category
  238. configurations and then the default configuration.  The first
  239. configuration found is the one that is applied.
  240.  
  241. The value of vm-mutable-windows must be non-nil for VM to use
  242. window configurations.
  243.  
  244. If vm-mutable-frames is non-nil and Emacs is running under X
  245. windows, then VM will use all existing frames.  Otherwise VM will
  246. restrict its changes to the frame in which it was started."
  247.   (interactive
  248.    (let ((last-command last-command)
  249.      (this-command this-command))
  250.      (if (null vm-window-configuration-file)
  251.      (error "Configurable windows not enabled.  Set vm-window-configuration-file to enable."))
  252.      (list
  253.       (intern
  254.        (completing-read "Name this window configuration: "
  255.             vm-supported-window-configurations
  256.             'identity t)))))
  257.   (if (null vm-window-configuration-file)
  258.       (error "Configurable windows not enabled.  Set vm-window-configuration-file to enable."))
  259.   (let (map p)
  260.     (setq map (tapestry (list (vm-selected-frame))))
  261.     ;; set frame map to nil since we don't use it.  this prevents
  262.     ;; cursor objects and any other objects that have an
  263.     ;; "unreadable" read syntax appearing in the window
  264.     ;; configuration file by way of frame-parameters.
  265.     (setcar map nil)
  266.     (tapestry-replace-tapestry-element map 'buffer-name 'vm-buffer-to-label)
  267.     (tapestry-nullify-tapestry-elements map t nil t t t nil)
  268.     (setq p (assq tag vm-window-configurations))
  269.     (if p
  270.     (setcar (cdr p) map)
  271.       (setq vm-window-configurations
  272.         (cons (list tag map) vm-window-configurations)))
  273.     (vm-store-window-configurations vm-window-configuration-file)
  274.     (message "%s configuration recorded" tag)))
  275.  
  276. (defun vm-buffer-to-label (buf)
  277.   (save-excursion
  278.     (set-buffer buf)
  279.     (cond ((eq major-mode 'vm-summary-mode)
  280.        'summary)
  281.       ((eq major-mode 'mail-mode)
  282.        'composition)
  283.       ((eq major-mode 'vm-mode)
  284.        'message)
  285.       ((eq major-mode 'vm-virtual-mode)
  286.        'message)
  287.       ((eq vm-system-state 'editing)
  288.        'edit)
  289.       (t buf))))
  290.  
  291. (defun vm-delete-window-configuration (tag)
  292.   "Delete the configuration saved for a particular action.
  293. This action will no longer have an associated window configuration.
  294. The action will be read from the minibuffer."
  295.   (interactive
  296.    (let ((last-command last-command)
  297.      (this-command this-command))
  298.      (if (null vm-window-configuration-file)
  299.      (error "Configurable windows not enabled.  Set vm-window-configuration-file to enable."))
  300.      (list
  301.       (intern
  302.        (completing-read "Delete window configuration: "
  303.             (mapcar (function
  304.                  (lambda (x)
  305.                    (list (symbol-name (car x)))))
  306.                 vm-window-configurations)
  307.             'identity t)))))
  308.   (if (null vm-window-configuration-file)
  309.       (error "Configurable windows not enabled.  Set vm-window-configuration-file to enable."))
  310.   (let (p)
  311.     (setq p (assq tag vm-window-configurations))
  312.     (if p
  313.     (if (eq p (car vm-window-configurations))
  314.         (setq vm-window-configurations (cdr vm-window-configurations))
  315.       (setq vm-window-configurations (delq p vm-window-configurations)))
  316.       (error "No window configuration set for %s" tag)))
  317.   (vm-store-window-configurations vm-window-configuration-file)
  318.   (message "%s configuration deleted" tag))
  319.  
  320. (defun vm-apply-window-configuration (tag)
  321.   "Change the current window configuration to be one
  322. associated with a particular action.  The action will be read
  323. from the minibuffer."
  324.   (interactive
  325.    (let ((last-command last-command)
  326.      (this-command this-command))
  327.      (list
  328.       (intern
  329.        (completing-read "Apply window configuration: "
  330.             (mapcar (function
  331.                  (lambda (x)
  332.                    (list (symbol-name (car x)))))
  333.                 vm-window-configurations)
  334.             'identity t)))))
  335.   (vm-set-window-configuration tag))
  336.  
  337. (defun vm-window-help ()
  338.   (interactive)
  339.   (message "WS = save configuration, WD = delete configuration, WW = apply configuration"))
  340.  
  341. (defun vm-iconify-frame ()
  342.   "Iconify the current frame.
  343. Run the hooks in vm-iconify-frame-hook before doing so."
  344.   (interactive)
  345.   (vm-check-for-killed-summary)
  346.   (vm-select-folder-buffer)
  347.   (if (vm-multiple-frames-possible-p)
  348.       (progn
  349.     (run-hooks 'vm-iconify-frame-hook)
  350.     (vm-iconify-frame-xxx))))
  351.  
  352. (defun vm-window-loop (action obj-1 &optional obj-2)
  353.   (let ((delete-me nil)
  354.     (done nil)
  355.     (all-frames (if vm-mutable-frames t nil))
  356.     start w)
  357.     (setq start (next-window (selected-window) 'nomini all-frames)
  358.       w start)
  359.     (and obj-1 (setq obj-1 (get-buffer obj-1)))
  360.     (while (not done)
  361.       (if (and delete-me (not (eq delete-me (next-window delete-me 'nomini))))
  362.       (progn
  363.         (delete-window delete-me)
  364.         (if (eq delete-me start)
  365.         (setq start nil))
  366.         (setq delete-me nil)))
  367.       (cond ((and (eq action 'delete) (eq obj-1 (window-buffer w)))
  368.          ;; a deleted window has no next window, so we
  369.          ;; defer the deletion until after we've moved
  370.          ;; to the next window.
  371.          (setq delete-me w))
  372.         ((and (eq action 'replace) (eq obj-1 (window-buffer w)))
  373.          (set-window-buffer w obj-2)))
  374.       (setq done (eq start
  375.              (setq w
  376.               (condition-case nil
  377.                   (next-window w 'nomini all-frames)
  378.                 (wrong-number-of-arguments
  379.                  (next-window w 'nomini))))))
  380.       (if (null start)
  381.       (setq start w)))
  382.     (if (and delete-me (not (eq delete-me (next-window delete-me 'nomini))))
  383.     (delete-window delete-me))))
  384.  
  385. (defun vm-frame-loop (action obj-1)
  386.   (if (fboundp 'vm-next-frame)
  387.       (let ((start (vm-selected-frame))
  388.         (delete-me nil)
  389.         (done nil)
  390.         f)
  391.     (setq f start)
  392.     (and obj-1 (setq obj-1 (get-buffer obj-1)))
  393.     (while (not done)
  394.       (if delete-me
  395.           (progn
  396.         (condition-case nil
  397.             (progn
  398.               (vm-delete-frame delete-me)
  399.               (if (eq delete-me start)
  400.               (setq start nil)))
  401.           (error nil))
  402.         (setq delete-me nil)))
  403.       (cond ((and (eq action 'delete)
  404.               ;; one-window-p doesn't take a frame argument
  405.               (eq (next-window (vm-frame-selected-window f) 'nomini)
  406.               (previous-window (vm-frame-selected-window f)
  407.                        'nomini))
  408.               ;; the next-window call is to avoid looking
  409.               ;; at the minibuffer window
  410.               (eq obj-1 (window-buffer
  411.                  (next-window
  412.                   (vm-frame-selected-window f)
  413.                   'nomini))))
  414.          ;; a deleted frame has no next frame, so we
  415.          ;; defer the deletion until after we've moved
  416.          ;; to the next frame.
  417.          (setq delete-me f))
  418.         ((eq action 'bury)
  419.          (bury-buffer obj-1)))
  420.       (setq done (eq start (setq f (vm-next-frame f))))
  421.       (if (null start)
  422.           (setq start f)))
  423.     (if delete-me
  424.         (progn
  425.           (vm-error-free-call 'vm-delete-frame delete-me)
  426.           (setq delete-me nil))))))
  427.  
  428. (defun vm-delete-windows-or-frames-on (buffer)
  429.   (and (eq vm-mutable-windows t) (vm-window-loop 'delete buffer))
  430.   (and vm-mutable-frames (vm-frame-loop 'delete buffer)))
  431.  
  432. (defun vm-replace-buffer-in-windows (old new)
  433.   (vm-window-loop 'replace old new))
  434.  
  435. (defun vm-bury-buffer (&optional buffer)
  436.   (or buffer (setq buffer (current-buffer)))
  437.   (if (vm-xemacs-p)
  438.       (if (vm-multiple-frames-possible-p)
  439.       (vm-frame-loop 'bury buffer)
  440.     (bury-buffer buffer))
  441.     (bury-buffer buffer)))
  442.  
  443. (defun vm-unbury-buffer (buffer)
  444.   (save-excursion
  445.     (save-window-excursion
  446.       (switch-to-buffer buffer))))
  447.  
  448. (defun vm-get-buffer-window (buffer)
  449.   (condition-case nil
  450.       (or (get-buffer-window buffer nil nil)
  451.       (and vm-search-other-frames
  452.            (get-buffer-window buffer t t)))
  453.     (wrong-number-of-arguments
  454.      (condition-case nil
  455.      (or (get-buffer-window buffer nil)
  456.          (and vm-search-other-frames
  457.           (get-buffer-window buffer t)))
  458.        (wrong-number-of-arguments
  459.     (get-buffer-window buffer))))))
  460.  
  461. (defun vm-get-visible-buffer-window (buffer)
  462.   (condition-case nil
  463.       (or (get-buffer-window buffer nil nil)
  464.       (and vm-search-other-frames
  465.            (get-buffer-window buffer t nil)))
  466.     (wrong-number-of-arguments
  467.      (condition-case nil
  468.      (or (get-buffer-window buffer nil)
  469.          (and vm-search-other-frames
  470.           (get-buffer-window buffer 'visible)))
  471.        (wrong-number-of-arguments
  472.     (get-buffer-window buffer))))))
  473.  
  474. (defun vm-set-hooks-for-frame-deletion ()
  475.   (make-local-variable 'vm-undisplay-buffer-hook)
  476.   (make-local-variable 'kill-buffer-hook)
  477.   (add-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame)
  478.   (add-hook 'kill-buffer-hook 'vm-delete-buffer-frame))
  479.  
  480. (defun vm-delete-buffer-frame ()
  481.   (save-excursion
  482.     (let ((w (vm-get-visible-buffer-window (current-buffer)))
  483.       (b (current-buffer)))
  484.       (and w (eq (vm-selected-frame) (vm-window-frame w))
  485.        (vm-error-free-call 'vm-delete-frame (vm-window-frame w)))
  486.       (and w (let ((vm-mutable-frames t))
  487.            (vm-delete-windows-or-frames-on b)))))
  488.   ;; do it only once
  489.   (remove-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame)
  490.   (remove-hook 'kill-buffer-hook 'vm-delete-buffer-frame))
  491.  
  492. (defun vm-goto-new-frame (&rest types)
  493.   (let ((params nil))
  494.     (while (and types (null params))
  495.       (setq params (car (cdr (assq (car types) vm-frame-parameter-alist)))
  496.         types (cdr types)))
  497.     ;; these functions might be defined in an Emacs that isn't
  498.     ;; running under a window system, but VM always checks for
  499.     ;; multi-frame support before calling this function.
  500.     (cond ((fboundp 'make-frame)
  501.        (select-frame (make-frame params)))
  502.       ((fboundp 'make-screen)
  503.        (select-screen (make-screen params)))
  504.       ((fboundp 'new-screen)
  505.        (select-screen (new-screen params))))
  506.     (and vm-warp-mouse-to-new-frame
  507.      (vm-warp-mouse-to-frame-maybe (vm-selected-frame)))))
  508.  
  509. (defun vm-warp-mouse-to-frame-maybe (&optional frame)
  510.   (or frame (setq frame (vm-selected-frame)))
  511.   (if (vm-mouse-support-possible-p)
  512.       (cond ((vm-mouse-xemacs-mouse-p)
  513.          (cond ((fboundp 'mouse-position);; XEmacs 19.12
  514.             (let ((mp (mouse-position)))
  515.               (if (and (car mp)
  516.                    (eq (window-frame (car mp)) (selected-frame)))
  517.               nil
  518.             (set-mouse-position (frame-highest-window frame)
  519.                         (/ (frame-width frame) 2)
  520.                         (/ (frame-height frame) 2)))))
  521.            (t ;; XEmacs 19.11
  522.             ;; use (apply 'screen-...) instead of
  523.             ;; (screen-...) to avoid stimulating a
  524.             ;; byte-compiler bug in Emacs 19.29 that
  525.             ;; happens when it encounters 'obsolete'
  526.             ;; functions.  puke, puke, puke.
  527.             (let ((mp (read-mouse-position frame)))
  528.               (if (and (>= (car mp) 0)
  529.                    (<= (car mp) (apply 'screen-width frame))
  530.                    (>= (cdr mp) 0)
  531.                    (<= (cdr mp) (apply 'screen-height frame)))
  532.               nil
  533.             (set-mouse-position frame
  534.                         (/ (apply 'screen-width frame) 2)
  535.                         (/ (apply 'screen-height frame) 2)))))))
  536.         ((vm-fsfemacs-19-p)
  537.          (let ((mp (mouse-position)))
  538.            (if (and (eq (car mp) frame)
  539.             ;; nil coordinates mean that the mouse
  540.             ;; pointer isn't really within the frame
  541.             (car (cdr mp)))
  542.            nil
  543.          (set-mouse-position frame
  544.                      (/ (frame-width frame) 2)
  545.                      (/ (frame-height frame) 2))
  546.          ;; doc for set-mouse-position says to do this
  547.          (unfocus-frame)))))))
  548.  
  549. (fset 'vm-selected-frame
  550.       (symbol-function
  551.        (cond ((fboundp 'selected-frame) 'selected-frame)
  552.          ((fboundp 'selected-screen) 'selected-screen)
  553.          (t 'ignore))))
  554.  
  555. (fset 'vm-delete-frame
  556.       (symbol-function
  557.        (cond ((fboundp 'delete-frame) 'delete-frame)
  558.          ((fboundp 'delete-screen) 'delete-screen)
  559.          (t 'ignore))))
  560.  
  561. ;; xxx because vm-iconify-frame is a command
  562. (defun vm-iconify-frame-xxx (&optional frame)
  563.   (cond ((fboundp 'iconify-frame)
  564.      (iconify-frame frame))
  565.     ((fboundp 'iconify-screen)
  566.      (iconify-screen (or frame (selected-screen))))))
  567.  
  568. (fset 'vm-raise-frame
  569.       (symbol-function
  570.        (cond ((fboundp 'raise-frame) 'raise-frame)
  571.          ((fboundp 'raise-screen) 'raise-screen)
  572.          (t 'ignore))))
  573.  
  574. (fset 'vm-frame-visible-p
  575.       (symbol-function
  576.        (cond ((fboundp 'frame-visible-p) 'frame-visible-p)
  577.          ((fboundp 'screen-visible-p) 'screen-visible-p)
  578.          (t 'ignore))))
  579.  
  580. (fset 'vm-window-frame
  581.       (symbol-function
  582.        (cond ((fboundp 'window-frame) 'window-frame)
  583.          ((fboundp 'window-screen) 'window-screen)
  584.          (t 'ignore))))
  585.  
  586. (cond ((fboundp 'next-frame)
  587.        (fset 'vm-next-frame (symbol-function 'next-frame))
  588.        (fset 'vm-select-frame (symbol-function 'select-frame))
  589.        (fset 'vm-frame-selected-window
  590.          (symbol-function 'frame-selected-window)))
  591.       ((fboundp 'next-screen)
  592.        (fset 'vm-next-frame (symbol-function 'next-screen))
  593.        (fset 'vm-select-frame (symbol-function 'select-screen))
  594.        (fset 'vm-frame-selected-window
  595.          (if (fboundp 'epoch::selected-window)
  596.          (symbol-function 'epoch::selected-window)
  597.            (symbol-function 'screen-selected-window))))
  598.       (t
  599.        ;; it is useful for this to be a no-op, but don't bind the
  600.        ;; others.
  601.        (fset 'vm-select-frame 'ignore)))
  602.